home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 038a / dosbasic.zip / DEMO.BAS < prev    next >
BASIC Source File  |  1990-12-19  |  14KB  |  535 lines
  1. '===========================================================================
  2. 'DOS/UTILITY routines
  3. 'UPDATED 12/18/90
  4. 'ErrorHandler IS REQUIRED!!!
  5. 'Necessary for graceful recovery of errors
  6. '===========================================================================
  7. DEFINT A-Z
  8. REM $INCLUDE: 'DFILE.BI'
  9.  
  10. 'Draws Boxes on the Screen, I have faster MASM video routines in
  11. 'VIDBASIC.ZIP
  12. DECLARE SUB Box (ULR%, ULC%, LRR%, LRC%, TitleMen%)
  13. 'Returns Current Filename in DOS version 3.xx and above
  14. DECLARE SUB GetCurrentFile (FileName$)
  15. 'Gets current path and drive
  16. DECLARE FUNCTION GetCurrPath$ ()
  17. 'Returns current physical and logical drive information
  18. DECLARE SUB DriveInfo ()
  19. 'Select attractive cursor and screen color
  20. DECLARE SUB BackGround ()
  21.  
  22. DIM SHARED ErrCode%
  23. DIM SHARED PATH AS STRING * 64
  24. CONST False = 0, True = NOT False
  25. 'saves space
  26. DIM SHARED Zero$: Zero$ = CHR$(0)
  27.  
  28. DIM SHARED Bgrnd%  'so we can keep track of display color
  29.  
  30. CALL BackGround
  31. CLS                'clear display to background color
  32.  
  33. ULR = 1: ULC = 1: LRR = 25: LRC = 80: TitleMen = 1
  34. CALL Box(ULR%, ULC%, LRR%, LRC%, TitleMen%)  'draw title screen box
  35.  
  36. LOCATE 2, 15
  37. COLOR Bgrnd%, 7
  38. PRINT "System Information Routines (C) Copr. 1990 - SJKelly"
  39. COLOR 7, Bgrnd%
  40.  
  41.  
  42. CALL HARDRIVES(HARD%)          'select default drive"
  43.     T$ = LEFT$(COMMAND$, 1)   'unless something different entered
  44.     IF LEN(T$) = 0 THEN       'at command line when start program
  45.         IF HARD% THEN
  46.             T$ = "C"
  47.         ELSE
  48.             T$ = "A"
  49.         END IF
  50.     END IF
  51.  
  52.     T$ = UCASE$(T$)
  53.  
  54.     LOCATE 3, 15
  55.     PRINT "Processors:    ";
  56.  
  57.     TCPU% = GETCPU%
  58.     SELECT CASE TCPU%
  59.         CASE 20
  60.             PRINT "NEC V20";
  61.         CASE 30
  62.             PRINT "NEC V30";
  63.         CASE ELSE
  64.             PRINT "80" + LTRIM$(STR$(TCPU%));
  65.     END SELECT
  66.  
  67.     TNDP% = CHECK87%
  68.     PRINT " with";
  69.     SELECT CASE TNDP%
  70.         CASE 0
  71.             PRINT "out a math";
  72.         CASE -87
  73.             PRINT " a software emulator";
  74.         CASE 87
  75.             PRINT " an 8087";
  76.         CASE 287
  77.             PRINT " an 80287";
  78.         CASE 387   'cannot distinguish between 487 & 387 except for speed
  79.             PRINT " an 80387";
  80.         END SELECT
  81.     PRINT " coprocessor."
  82.  
  83.     'get information about available memory
  84.     CALL OTHERMEMORY(EXTENDED%, EXPANDED%, XMS%)
  85.     'get some regular information too
  86.     CALL EQUIPMENT(RegMem%, NoPrinters%, ComPorts%)
  87.  
  88.     LOCATE 5, 3
  89.     PRINT "Memory in KB: "; RegMem%; "DOS,";
  90.     PRINT EXPANDED%; "EMS & "; XMS%; "XMS."
  91.     LOCATE , 3
  92.     
  93.     IF ACTUALEXTND < 0 THEN
  94.         PRINT "CMOS battery is about dead, better replace it."
  95.     ELSE
  96.         PRINT "Actual Extended:"; ACTUALEXTND%; "kb"; TAB(42);
  97.         PRINT "Free Extended:"; EXTENDED%; "kb."
  98.     END IF
  99.  
  100.     LOCATE , 3
  101.     Ansi = ANSICHECK%
  102.     PRINT "ANSI Driver:   ";
  103.     IF Ansi THEN
  104.         PRINT "IS installed.";
  105.     ELSE
  106.         PRINT "NOT installed.";
  107.     END IF
  108.     PRINT
  109.  
  110.     VERSION$ = SPACE$(4)
  111.     CALL GETDOSVER(VERSION$)
  112.     LOCATE , 3
  113.     PRINT "DOS Version:   "; VERSION$;
  114.  
  115.     'check if we are operating under a multitasking environment
  116.     CALL OTHEROPER(DPMI%, WINDOWS%, DESQVIEW)
  117.     PRINT TAB(42); "Multitasker:";
  118.     IF (DPMI + WINDOWS + DESQVIEW) THEN
  119.          IF DPMI% THEN PRINT " DPMI";
  120.          IF WINDOWS% THEN PRINT " WINDOWS";
  121.          IF DESQVIEW% THEN PRINT " DESQVIEW";
  122.          PRINT
  123.     ELSE
  124.         PRINT " None."
  125.     END IF
  126.     PRINT
  127.  
  128.     LOCATE , 3
  129.     FOR x = 1 TO NoPrinters
  130.         IF PRINTRDY%(x) THEN
  131.             PRINT "LPT"; CHR$(x + 48); ": printer ready.   ";
  132.         ELSE
  133.             PRINT "LPT"; CHR$(x + 48); ": printer error.   ";
  134.         END IF
  135.     NEXT
  136.     PRINT
  137.  
  138.     LOCATE , 3
  139.     PRINT "You have"; ComPorts; "COM ports installed."
  140.     PRINT
  141.  
  142.     CALL GetCurrentFile(FileName$)
  143.     LOCATE , 3
  144.     PRINT "Current file name:  "; FileName$
  145.  
  146.     IF LEN(FileName$) = 0 THEN FileName$ = "QB.EXE"
  147.  
  148. 'need to trap open doors & invalid drives
  149. ON ERROR GOTO ErrorHandler
  150.  
  151.     'strip off the leading drive and subdirectory names
  152.     DO
  153.         FileName$ = MID$(FileName$, INSTR(FileName$, "\") + 1)
  154.         IF INSTR(FileName$, "\") = 0 THEN EXIT DO
  155.     LOOP
  156.  
  157.     Mode% = 0  '0 means normal read access, <> 0 means read/write access
  158.     CALL EXIST(FileName$ + Zero$, ErrCode%, Mode%)
  159.  
  160.     LOCATE , 3
  161.     IF ErrCode% THEN
  162.         PRINT "Sorry, "; FileName$; " not found in current directory."
  163.     ELSE
  164.         PRINT FileName$; " found in current directory."
  165.     END IF
  166.  
  167.     FirstDrive$ = "z:"
  168.     CALL GETDRIVE(FirstDrive$)
  169.  
  170.     LOCATE , 3
  171.     PRINT "Changing Drive to Drive "; T$; ":";
  172.     CALL SETDRIVE(T$, ErrCode%)
  173.  
  174.     LOCATE , 3
  175.     IF ErrCode% THEN
  176.         PRINT "Drive invalid, old value retained.";
  177.     ELSE
  178.         CALL SUBSTDRIVE(T$, ErrCode%)
  179.         IF (ErrCode% = 2) THEN
  180.             PRINT "Drive "; T$; " is a SUBST drive."
  181.         ELSE
  182.             PRINT
  183.         END IF
  184.     END IF
  185.  
  186.  
  187.     LOCATE , 3
  188.     PRINT "Current Drive and Path is "; GetCurrPath$;
  189.         IF ErrCode% THEN
  190.             PRINT " Error reported."
  191.         ELSE
  192.             PRINT
  193.         END IF
  194.  
  195.     CALL DRVSPACE(T$, F&)
  196.     LOCATE , 3
  197.     IF F& = 0 THEN
  198.         PRINT "Selected drive was invalid."
  199.     ELSE
  200.         PRINT "Drive "; T$; ": has";
  201.         PRINT USING "##########,"; F&;
  202.         PRINT " Bytes free."
  203.     END IF
  204.     PRINT
  205.  
  206.     'return to where we started, assume still valid
  207.     LOCATE , 3
  208.     PRINT "Returning to Original Drive: "; FirstDrive$
  209.     CALL SETDRIVE(FirstDrive$, ErrCode%)
  210.  
  211. 'turn off error checking to show how the following routines work
  212. ON ERROR GOTO 0
  213.  
  214. CALL DriveInfo
  215.  
  216. LOCATE 23, 1
  217.  
  218. DO        'Wait until Key press
  219. LOOP UNTIL LEN(INKEY$)
  220.  
  221. SCREEN 0, , 0, 0
  222. CLS
  223. ULR = 9: ULC = 1: LRR = 25: LRC = 80: TitleMen = 1
  224. CALL Box(ULR%, ULC%, LRR%, LRC%, TitleMen%)  'draw title screen box
  225.  
  226. LOCATE 10, 3
  227. PRINT "The MASM routines used by this DEMO are";
  228. LOCATE 11, 9
  229.  
  230. TemHead$ = "Copr. Copyright (C) 1990, Sidney J. Kelly, All rights Reserved."
  231. PRINT TemHead$;
  232. LOCATE 13, 3
  233. PRINT "Your ROM BIOS shows the following information:"
  234. LOCATE 15, 3
  235. PRINT "ROM BIOS date is: "; SPC(24);
  236. RomDate$ = SPACE$(8)
  237. SegAddress% = &HFFFF: OffAddress% = &H5
  238. CALL MEM2STRING(RomDate$, SegAddress%, OffAddress%)
  239. PRINT RomDate$
  240.  
  241. LOCATE 16, 3
  242. CopyRight$ = SPACE$(90)
  243. SegAddress% = &HFE00: OffAddress% = &H0
  244. CALL MEM2STRING(CopyRight$, SegAddress%, OffAddress%)
  245. Temp$ = UCASE$(CopyRight$)  'squeeze out unnecessary information
  246. Lengt = LEN(CopyRight$)
  247. Temp = INSTR(Temp$, "CO")
  248. CopyRight$ = RTRIM$(RIGHT$(CopyRight$, Lengt - Temp + 1))
  249. PRINT "ROM: "; CopyRight$
  250.  
  251. LOCATE 18, 3
  252. CALL DRIVEALIAS(ASSIGN%, DAPPEND%, NETWORK%, SHARE%)
  253. PRINT "ASSIGN is: ";
  254. IF ASSIGN THEN
  255.     PRINT "active.   ";
  256. ELSE
  257.     PRINT "inactive.   ";
  258. END IF
  259.  
  260. PRINT TAB(32); "APPEND is: ";
  261. IF DAPPEND THEN
  262.     PRINT "active."
  263. ELSE
  264.     PRINT "inactive."
  265. END IF
  266.  
  267. LOCATE 19, 3
  268.  
  269. PRINT "MS NETWORK is: ";
  270. IF NETWORK THEN
  271.     PRINT "active.   ";
  272. ELSE
  273.     PRINT "inactive.   ";
  274. END IF
  275.  
  276. PRINT TAB(32); "SHARE is: ";
  277. IF SHARE THEN
  278.     PRINT "active."
  279. ELSE
  280.     PRINT "inactive."
  281. END IF
  282.  
  283. LOCATE 24, 27
  284. COLOR Bgrnd%, 7
  285. PRINT "Press any key to quit.";
  286. COLOR 7, Bgrnd%
  287.  
  288. DO        'Wait until Key press
  289. LOOP UNTIL LEN(INKEY$)
  290.  
  291. CLS
  292. LOCATE 10, 3
  293. PRINT "The MASM routines used by this DEMO are now printed backwards";
  294. LOCATE 11, 1
  295.  
  296. CALL REVERSESTRING(TemHead$)
  297. PRINT TemHead$
  298. SLEEP 1
  299.  
  300. CALL REVERSESTRING(TemHead$)
  301. PRINT TemHead$
  302. SLEEP 1
  303.  
  304. 'need an end to avoid crashing into ErrorHandler
  305. END
  306.  
  307. 'Necessary for graceful recovery of errors
  308. ErrorHandler:
  309.     SELECT CASE ERR
  310.         CASE 53, 76   'File does not exist, an expected error
  311.             RESUME NEXT
  312.         CASE 75       'File does not exist, an expected error
  313.             RESUME NEXT
  314.         CASE 57, 68   'Drive is invalid generating an I/O error
  315.             ErrCode = True
  316.             RESUME NEXT
  317.         CASE 64       '"Bad filename", an expected error
  318.             RESUME NEXT
  319.         CASE 71                  'door open on the drive
  320.             ErrCode% = True
  321.             RESUME NEXT
  322.         CASE ELSE
  323.             LOCATE , 3
  324.             PRINT " Error occurred:"; ERR
  325.     END SELECT
  326.  
  327. '==============================Background===================================
  328. ' Selects a nice background and cursor size
  329. ' depending on the type of CRT
  330. ' QBASIC selects a cursor that is properly sized only for the CGA
  331. ' Updated 1/9/90
  332. '===========================================================================
  333. SUB BackGround STATIC
  334.     'Check BIOS area of RAM
  335.     DEF SEG = &H40
  336.     'CRTMode = PEEK(&H63)     'Check CRT port
  337.     IF PEEK(&H63) = &HB4 THEN
  338.         'if CRTMode = &HB4  then CRTMode is a Mono display
  339.         Bgrnd% = 0           'use a black background
  340.         LOCATE , , , 12, 13  'Pleasant cursor size
  341.     ELSE
  342.         'else a Color display (correct for EGA/VGA only if cursor
  343.                          'emulation is on).
  344.         Bgrnd% = 1           'use a blue background.  However,
  345.                          'on a COMPAQ portable or EGA/VGA monochrome
  346.                          'this is NOT attractive.
  347.         LOCATE , , , 6, 7    'Pleasant cursor size
  348.     END IF
  349.     COLOR 7, Bgrnd%
  350.     'restore Def Seg
  351.     DEF SEG
  352.  
  353. 'Note a VGA can appear as a color or mono display depending upon
  354. 'the current BIOS mode and depending if monitor was on when the machine
  355. 'was turned on.
  356.  
  357. END SUB
  358.  
  359. '------------------------------Draw Boxes------------------------------------
  360. ' DRAW A BOX AT SPECIFIED COORDINATES
  361. ' This is a generic routine that can be used to draw a box anywhere.
  362. ' ULR% is the starting row. ULC% is the starting column.
  363. ' LRR% is the ending row. LRC% is the ending column.
  364. ' If the paramater TitleMen% is > 0, then prints horizontal bars
  365. ' three rows down from the top of the box and two rows up from the bottom.
  366. ' If TitleMen% is set to 0, the routine will print a plain box.
  367. ' This can create a quick frame for a title screen.
  368. '
  369. ' In my VIDBASIC library is a much faster MASM routine.  This routine is
  370. ' added because it is generic and needs no MASM support
  371. '----------------------------------------------------------------------------
  372. SUB Box (ULR%, ULC%, LRR%, LRC%, TitleMen%) STATIC
  373.  
  374. 'to make the definitions local to routine
  375. STATIC BoxTop, BoxTop$, BoxBottom$, BoxMiddle$
  376.  
  377. 'CONST is used for speed
  378. CONST BoxSide$ = "║"  'box side    CHR$(186)
  379. CONST UpLeft$ = "╔"   'upper left  CHR$(201)
  380. CONST UpRight$ = "╗"  'upper right CHR$(187)
  381. CONST LowLeft$ = "╚"  'lower left  CHR$(200)
  382. CONST LowRight$ = "╝" 'lower right CHR$(188)
  383. CONST LeftTee$ = "╠"  'left T      CHR$(204)
  384. CONST RightTee$ = "╣" 'right T     CHR$(185)
  385.  
  386. 'The first piece of code sets up the strings for box drawing
  387. BoxTop = (LRC% - ULC%) - 1
  388. IF BoxTop < 0 THEN BoxTop = 0        'keep variable within range
  389.  
  390. BoxTop$ = UpLeft$ + STRING$(BoxTop, 205) + UpRight$
  391. BoxBottom$ = LowLeft$ + STRING$(BoxTop, 205) + LowRight$
  392.  
  393. 'This prints the top of the box
  394. LOCATE ULR%, ULC%: PRINT BoxTop$;
  395.  
  396. 'Print the sides of the box
  397. FOR E1% = ULR% + 1 TO LRR% - 1
  398.     LOCATE E1%, ULC%: PRINT BoxSide$;
  399.     LOCATE E1%, LRC%: PRINT BoxSide$;
  400. NEXT
  401.  
  402. 'Print the bottom of the box
  403. LOCATE LRR%, ULC%: PRINT BoxBottom$;
  404.  
  405. 'Optionally prints horizontal lines at top and bottom of the box
  406. 'To set up title and menu screens.
  407. IF TitleMen% > 0 THEN
  408.     BoxMiddle$ = LeftTee$ + STRING$(BoxTop, 205) + RightTee$
  409.     LOCATE ULR% + 3, ULC%: PRINT BoxMiddle$;
  410.     LOCATE LRR% - 2, ULC%: PRINT BoxMiddle$;
  411. END IF
  412.  
  413. 'speed up garbage collection and allow use of STATIC
  414.  BoxTop$ = "": BoxBottom$ = "": BoxMiddle$ = ""
  415.  
  416. END SUB
  417.  
  418. '===========================================================================
  419. ' Returns information concerning logical and physical drives
  420. '
  421. ' Updated 6/20/90
  422. '===========================================================================
  423. SUB DriveInfo STATIC
  424.  
  425.     DirNos% = FINDDRIVES%
  426.     LOCATE , 3
  427.     PRINT "Logical  Drives: ";
  428.     PRINT " A: to " + CHR$(64 + DirNos%) + ":"
  429.  
  430.     CALL FLOPPYDRIVES(NoDrives%)
  431.     CALL HARDRIVES(HARD%)
  432.  
  433.     LOCATE , 3
  434.     PRINT "Physical Drives: "; HARD%;
  435.     PRINT "Hard Drive(s),"; NoDrives%; "Floppy Drive(s)."
  436.  
  437.     LOCATE , 3
  438.     IF NoDrives = 1 THEN
  439.         DEF SEG = 0
  440.         Mimic = PEEK(&H504)
  441.         DEF SEG
  442.         PRINT "Drive A: is currently acting as Drive ";
  443.  
  444.         'Mimic = 0 if acting as A:, 1 if B: and 255 if never used drive A
  445.         IF (Mimic = 1) THEN
  446.             PRINT "B:"
  447.         ELSE
  448.             PRINT "A:"
  449.         END IF
  450.     END IF
  451.  
  452.     Drive$ = "A:"
  453.     CALL FLOPPYREADY(Drive$, ErrCode%)
  454.     LOCATE 24, 3
  455.     PRINT "Floppy Drive "; Drive$;
  456.  
  457.     SELECT CASE ErrCode%
  458.         CASE 0
  459.             PRINT " is valid and has the door closed.";
  460.         CASE 128
  461.             PRINT " has its door open.";
  462.         CASE 80
  463.             PRINT " has a track error.";
  464.         CASE -1
  465.             PRINT " is not valid.";
  466.     END SELECT
  467.  
  468. END SUB
  469.  
  470. '===========================================================================
  471. ' Returns the current running file name based on the current
  472. ' PSP for the program.
  473. ' Works in DOS version 3.xx and above.
  474. ' Inside QB.EXE will always report QB.EXE
  475. ' Updated 7/20/90
  476. '===========================================================================
  477. SUB GetCurrentFile (FileName$) STATIC
  478.  
  479.     FileName$ = SPACE$(64)
  480.     CALL GETCURRENTNAME(FileName$, FileNameLen%)
  481.  
  482.     IF FileNameLen% > 0 THEN
  483.         FileName$ = UCASE$(LEFT$(FileName$, FileNameLen%))
  484.     ELSE
  485.         FileName$ = ""
  486.     END IF
  487.  
  488. END SUB
  489.  
  490. '===========================================================================
  491. ' Returns Complete Current Drive and Path$
  492. ' Also detects if SUBST, ASSIGN, JOIN are at work
  493. ' Updated 9/26/90
  494. '===========================================================================
  495. FUNCTION GetCurrPath$ STATIC
  496.  
  497.     STATIC D$, T$, P$
  498.  
  499.     ErrCode% = False%
  500.     T$ = SPACE$(67)
  501.     CALL GETFULLPATH(T$, PATHLEN%)
  502.  
  503.     IF (PATHLEN% = -1) OR ErrCode% THEN
  504.         GetCurrPath$ = ""
  505.         T$ = ""
  506.         EXIT FUNCTION
  507.     END IF
  508.  
  509.     T$ = LEFT$(T$, PATHLEN%)
  510.  
  511.     D$ = ".": P$ = SPACE$(67)
  512.     CALL TRUENAME(D$ + Zero$, P$, FileLen%)
  513.     SELECT CASE FileLen
  514.         CASE 0
  515.             'Dos Version 2.xx so TrueName wont work & SHARE, ASSIGN
  516.             'SUBST, & JOIN are by definition inactive
  517.         CASE -1
  518.             PRINT " Current Path$ contains unknown error.": END
  519.         CASE 1 TO 67
  520.             P$ = LEFT$(P$, FileLen%)
  521.             IF P$ <> T$ THEN
  522.                 PRINT " Warning! ASSIGN, JOIN, or SUBST active."
  523.                 PRINT " Please remove from BATCH files and reboot!!"
  524.                 T$ = "Error r r r"
  525.             END IF
  526.         CASE ELSE
  527.     END SELECT
  528.  
  529.     GetCurrPath$ = T$
  530.  
  531.     T$ = "": D$ = "": P$ = ""
  532.  
  533. END FUNCTION
  534.  
  535.